home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / html_frame.tcl.z / html_frame.tcl
Text File  |  2002-07-08  |  8KB  |  300 lines
  1. # frame.tcl
  2. # Display HTML frames.
  3. # See license.terms for copyright info.
  4.  
  5. # These two arrays are used to parameterize placement algorithms
  6. # An upvar is used to alias one of them to the variable F.  For example,
  7. # F(d) is the coordinate that changes for each row(col)
  8. array set Frame_rows {
  9.     args0    "-anchor n -relw 1.0 -relx 0.5"
  10.     barargs    "-anchor sw -relw 1.0 -relx 0.0"
  11.     boxargs    "-anchor s -relx 0.5"
  12.     footargs    "-relx 1.0 -y 0 -relh 1.0 -anchor ne -x -1"
  13.     butargs    "-relx 0.2 -rely 0.5 -anchor w"
  14.     size    height
  15.     osize    width
  16.     relsize    relh
  17.     d        y
  18.     D        Y
  19.     dd        x
  20.     DD        X
  21.     other    cols
  22. }
  23. array set Frame_cols {
  24.     args0    "-anchor w -relh 1.0 -rely 0.5"
  25.     barargs    "-anchor ne -relh 1.0 -rely 0.0"
  26.     boxargs    "-anchor e -rely 0.5"
  27.     footargs    "-x 0 -rely 1.0 -relw 1.0 -anchor sw"
  28.     butargs    "-rely 0.2 -relx 0.5 -anchor n"
  29.     size    width
  30.     osize    height
  31.     relsize    relw
  32.     d        x
  33.     D        X
  34.     dd        y
  35.     DD        Y
  36.     other    rows
  37. }
  38.  
  39.  
  40. proc Frame_Reset {win} {
  41.     upvar #0 HM$win var Frame$win frame
  42.     FrameTweakUI $win on
  43.     catch {unset frame}
  44.     catch {unset var(S_targets)}
  45.     catch {unset var(S_outproc)}
  46. }
  47.  
  48. # FrameTweakUI does two things.  First it fiddle with the Edit button
  49. # in the main control panel to turn it into a menu when displaying frames.
  50. # Second, it places a frame over the regular display that holds all the frames.
  51. proc FrameTweakUI {win how} {
  52.     upvar #0 Frame$win frame
  53.     set parent [winfo parent $win]
  54.     set top [winfo toplevel $win]
  55.     if {[string compare $top .] == 0} {
  56.     set dot ""
  57.     } else {
  58.     set dot .
  59.     }
  60.     set edit $top${dot}url.edit
  61.     set menu $top${dot}url.edit.frame.m
  62.     if {[string compare $parent .] == 0} {
  63.     set dot ""
  64.     } else {
  65.     set dot .
  66.     }
  67.     set main $parent${dot}main
  68.     if ![winfo exists $main] {
  69.     # Embedded frames
  70.     set main $parent
  71.     }
  72.     set f $parent${dot}frame
  73.     if {$how == "on"} {
  74.     if {$top == $parent} {
  75.         pack forget $edit.frame
  76.         pack $edit.normal
  77.         catch {$menu delete 0 end}
  78.         catch {$menu add command -label Frameset \
  79.             -command [list Frameset_Edit $win]}
  80.     }
  81.     catch {destroy $frame(master)}
  82.     } else {
  83.     if {$top == $parent} {
  84.         pack propagate $edit off
  85.         pack forget $edit.normal
  86.         pack $edit.frame
  87.     }
  88.     set frame(master) [frame $f]
  89.     set frame(menu) $menu
  90.     place $f -in $main -anchor nw -x 0 -y 0 -relw 1.0 -relh 1.0
  91.     }
  92.     return $f
  93. }
  94. proc HMtag_frameset {win param text} {
  95.     upvar #0 HM$win var Frame$win frame
  96.     if ![info exists frame(level)] {
  97.     set frame(do_display) 1
  98.     set frame(level) 0
  99.     set frame(color) FF
  100.     set frame(frameset) {}
  101.     set frame(display) {}
  102.     set parent [FrameTweakUI $win off]
  103.     set var(S_outproc) Frameset_Output
  104.     } else {
  105.     incr frame(level)
  106.     set frameset [lindex $frame(frameset) end]
  107.     set parent [lindex $frameset 0]
  108.     set frameset [lreplace $frameset 0 0]
  109.     set frame(frameset) [lreplace $frame(frameset) end end $frameset]
  110.     }
  111.     HMextract_param $param rows
  112.     HMextract_param $param cols
  113.     if {![info exists rows] && ![info exists cols]} {
  114.     set spec *
  115.     set key rows
  116.     } elseif {[info exists rows] && [info exists cols]} {
  117.     # oops - both rows and columns specified.
  118.     # Figure out which one to ignore.
  119.     set spec *
  120.     set key rows
  121.     foreach x [split $rows ,] {
  122.         if ![regexp {^(100%|\*)$} $x] {
  123.         set key rows
  124.         set spec $rows
  125.         }
  126.     }
  127.     foreach x [split $cols ,] {
  128.         if ![regexp {^(100%|\*)$} $x] {
  129.         set key cols
  130.         set spec $cols
  131.         }
  132.     }
  133.     } elseif {[info exists rows]} {
  134.     set spec $rows
  135.     set key rows
  136.     } else {
  137.     set spec $cols
  138.     set key cols
  139.     }
  140.     set frame($key,$parent) $spec
  141.     set i 0
  142.     set frameset {}
  143.     foreach x [split $spec ,] {
  144.     set f [frame $parent.$key$i -class Frame]
  145.     place $f -in $parent    ;# true parameters set later
  146.     lappend frame(frames) $f
  147.     lappend frameset $f
  148.     set frame($key,$parent,$i,frame) $f
  149.     incr i
  150.     }
  151.     bind $parent <Configure> +[list FrameSize $win $parent $key]
  152.     lappend frame(frameset) $frameset    ;# Push a frameset
  153.     return $parent
  154. }
  155. proc FrameSize {win parent key} {
  156.     upvar #0 Frame$win frame
  157.     upvar #0 Frame_$key F
  158.     set spec $frame($key,$parent)
  159.     set max [winfo $F(size) $parent]
  160.     set i 0
  161.     set total 0
  162.     set expand 0
  163.     foreach x [split $spec ,] {
  164.     if {[regexp {^([0-9]+)$} $x _ pixels]} {
  165.         incr total $pixels
  166.         set frame($key,$parent,$i,size) $pixels
  167.     } elseif {[regexp {^([0-9]+)%$} $x _ percent]} {
  168.         set ratio [expr double($percent)/100.0]
  169.         set frame($key,$parent,$i,relsize) $ratio
  170.         incr total [expr int($ratio * double($max))]
  171.     } elseif {[regexp {([0-9]*)\*} $x _ mult]} {
  172.         if {[string length $mult] == 0} {
  173.         set mult 1
  174.         }
  175.         incr expand $mult
  176.         set frame($key,$parent,$i,mult) $mult
  177.     } else {
  178.         set frame($key,$parent,$i,size) 0
  179.     }
  180.     incr i
  181.     }
  182.     if {($expand > 0)} {
  183.     set frame(expand,$parent) $expand
  184.     set frame(total,$parent) $total
  185.     set frame(max,$parent) $max
  186.     if {($total < $max)} {
  187.         set share [expr (double($max) - double($total)) / \
  188.                 double($expand) / double($max)]
  189.     } else {
  190.         set share 0
  191.     }
  192.     set frame(share,$parent) $share
  193.    }
  194.     set i 0
  195.     set offset 0
  196.     set reloff 0.0
  197.     foreach x [split $spec ,] {
  198.     set args $F(args0)
  199.     lappend args -$F(d) $offset -rel$F(d) $reloff
  200.         if {[info exists frame($key,$parent,$i,mult)]} {
  201.         set ratio [expr $frame($key,$parent,$i,mult) * $share]
  202.         set frame($key,$parent,$i,relsize) $ratio
  203.     }
  204.         if {[info exists frame($key,$parent,$i,relsize)]} {
  205.         lappend args -$F(relsize) $frame($key,$parent,$i,relsize)
  206.         set reloff [expr $reloff + $frame($key,$parent,$i,relsize)]
  207.     }
  208.         if {[info exists frame($key,$parent,$i,size)]} {
  209.         lappend args -$F(size) $frame($key,$parent,$i,size)
  210.         incr offset $frame($key,$parent,$i,size)
  211.     }
  212.     set f $frame($key,$parent,$i,frame)
  213.     eval place $f $args
  214.     incr i
  215.     }
  216. }
  217. proc HMtag_/frameset {win param text} {
  218.     upvar #0 HM$win var Frame$win frame
  219.     if [info exists frame(level)] {
  220.     incr frame(level) -1
  221.     if {$frame(level) < 0} {
  222.         unset frame(level)
  223.         if {$frame(do_display)} {
  224.         foreach cmd $frame(display) {
  225.             eval $cmd
  226.         }
  227.         set frame(display) {}
  228.         }
  229.     }
  230.     }
  231.     if [info exists frame(frameset)] {
  232.     set frame(frameset) [lreplace $frame(frameset) end end]
  233.     }
  234.     return {}
  235. }
  236. proc HMtag_frame {win param text} {
  237.     upvar #0 HM$win var Frame$win frame
  238.     set mainwin [Window_GetMaster $win]
  239.     upvar #0 Frame$mainwin frame0
  240.  
  241.     set frameset [lindex $frame(frameset) end]
  242.     set parent [lindex $frameset 0]
  243.     set frameset [lreplace $frameset 0 0]
  244.     set frame(frameset) [lreplace $frame(frameset) end end $frameset]
  245.     set frame(html,$parent) [list frame $param]
  246.  
  247.     set scrolling auto
  248.     HMextract_param $param scrolling
  249.     set scrolling [string tolower $scrolling]
  250.  
  251.     set pady 2
  252.     HMextract_param $param marginheight pady
  253.     set padx 2
  254.     HMextract_param $param marginwidth padx
  255.  
  256.     set newwin [Window_Frame $win $parent $scrolling $padx $pady]
  257.     set name (noname)
  258.     if [HMextract_param $param name] {
  259.     # target of a href
  260.     set frame0(target,$name) $newwin
  261.     }
  262.     if [HMextract_param $param src url] {
  263.     set frame0(url,$name) $url
  264.     set frame0(src,$parent) $url
  265.     lappend frame(display) [list Url_DisplayFrame $newwin $url]
  266.     }
  267.     catch {
  268.     $frame(menu) add command -label $name \
  269.         -command [list Frame_Edit $win $name]
  270.     }
  271.     return $parent
  272. }
  273. proc Frame_Display {win name href} {
  274.     set mainwin [Window_GetMaster $win]
  275.     upvar #0 Frame$mainwin frame
  276.     if [info exists frame(target,$name)] {
  277.     set frame(url,$name) $href
  278.     Url_DisplayFrame $frame(target,$name) $href
  279.     } else {
  280.     Url_Display $win $href
  281.     }
  282. }
  283. proc Frame_Edit {win name} {
  284.     upvar #0 Frame[Window_GetMaster $win] frame
  285.     set newwin [Url_DisplayNew $frame(url,$name) $win]
  286.     Input_Mode $newwin Edit
  287. }
  288. proc HMtag_/frame {win param text} {
  289.     return {}
  290. }
  291. proc HMtag_noframes {win param text} {
  292.     upvar #0 HM$win var
  293.     set var(S_stop) 1
  294.     return {}
  295. }
  296. proc HMtag_/noframes {win param text} {
  297.     return {}
  298. }
  299.  
  300.